home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2001 May / SGI Freeware 2001 May - Disc 1.iso / dist / fw_stylesheets.idb / usr / freeware / lib / sgml / stylesheets / bosak-db3.dsl.z / bosak-db3.dsl
Text File  |  2000-07-20  |  61KB  |  1,933 lines
  1. <!doctype style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN">
  2.  
  3. ;; changes from 0.63 (last public release):
  4. ;;   all "start-indent: (inherited-start-indent)" removed
  5. ;;   n-rows spanned fixed for DocBook 3.0
  6. ;;   PART moved from component to division
  7. ;;   entityref handling fixed in graphics
  8.  
  9. ;; ######################################################################
  10. ;;
  11. ;; DSSSL style sheet for DocBook 2.x  and 3.x print output
  12. ;;
  13. ;; Version 0.68b    1997.03.24
  14. ;;
  15. ;; Jon Bosak, Sun Microsystems
  16. ;; CALS table formatting by Anders Berglund, EBT
  17. ;;
  18. ;; Other contributors: Tony Graham, Terry Allen
  19. ;;
  20. ;; To do:
  21. ;;   platform-independent way to invoke bullet chars etc.
  22. ;;   footnotes
  23. ;;   refmiscinfo, refdescriptor
  24. ;;   toc, lot
  25. ;;   segmentedlist, segtitle, seglistitem, seg
  26. ;;   calloutlist, callout
  27. ;;   screenshot, screeninfo, areaspec, area, areaset
  28. ;;   programlistingco, screenco, graphicco
  29. ;;   equation, informalequation, inlineequation
  30. ;;   syntax definition stuff
  31. ;;   index stuff
  32. ;;   links and anchors
  33. ;;   divide style sheet into modules
  34. ;;
  35. ;; ######################################################################
  36.  
  37.  
  38. ;; =========================== PARAMETERS ==============================
  39.  
  40. ;; Visual acuity levels are "normal", "presbyopic", and 
  41. ;;   "large-type"; set the line following to choose the level
  42.  
  43. (define %visual-acuity% "normal")
  44. ;; (define %visual-acuity% "presbyopic")
  45. ;; (define %visual-acuity% "large-type")
  46.  
  47. (define %bf-size%
  48.   (case %visual-acuity%
  49.     (("normal") 10pt)
  50.     (("presbyopic") 12pt)
  51.     (("large-type") 24pt)))
  52. (define-unit em %bf-size%)
  53.  
  54. ;; these font selections are for Windows 95
  55.  
  56. (define %title-font-family% "Arial")
  57. (define %body-font-family% "Times New Roman")
  58. (define %mono-font-family% "Courier New")
  59. (define %admon-font-family% "Arial")
  60. (define %dingbat-font-family% "WingDings")
  61.  
  62. (define %line-spacing-factor% 1.1)
  63. (define %head-before-factor% 0.75)
  64. (define %head-after-factor% 0.5)
  65.  
  66. (define %page-width% 8.5in)
  67. (define %page-height% 11in)
  68.  
  69. (define %left-right-margin% 6pi)
  70. (define %top-margin%
  71.   (if (equal? %visual-acuity% "large-type") 7.5pi 6pi))
  72. (define %bottom-margin%
  73.   (if (equal? %visual-acuity% "large-type") 7.5pi 6pi))
  74. (define %header-margin%
  75.   (if (equal? %visual-acuity% "large-type") 4.5pi 3pi))
  76. (define %footer-margin% 3pi)
  77.  
  78. (define %text-width% (- %page-width% (* %left-right-margin% 2)))
  79. (define %body-start-indent% 4pi)
  80. (define %pgwide-start-indent% %body-start-indent%)
  81. (define %body-width% (- %text-width% %body-start-indent%))
  82. (define %para-sep% (/ %bf-size% 2.0))
  83. (define %block-sep% (* %para-sep% 2.0))
  84. (define %hsize-bump-factor% 1.2)
  85. (define %ss-size-factor% 0.6)
  86. (define %ss-shift-factor% 0.4)
  87. (define %smaller-size-factor% 0.9)
  88.  
  89. ;; ====================== BASIC PARAGRAPH TEMPLATE ======================
  90.  
  91. (define ($paragraph$)
  92.   (make paragraph
  93.     use: para-style
  94.     space-before: %para-sep%
  95.     space-after: %para-sep%
  96.     quadding: 'start
  97.     (process-children-trim)))
  98.  
  99. ;; ============================== FUNCTIONS =============================
  100.  
  101. (define outer-parent-list
  102.   (list "TOC" "LOT" "APPENDIX" "CHAPTER" "PART" "PREFACE" "REFERENCE"
  103.     "BIBLIOGRAPHY" "GLOSSARY" "INDEX" "SETINDEX"
  104.     "SECT1" "SECT2" "SECT3" "SECT4" "SECT5" "SIMPLESECT"
  105.     "PARTINTRO" "BIBLIODIV" "GLOSSDIV" "INDEXDIV"
  106.     "REFENTRY" "REFSECT1" "REFSECT2" "REFSECT3"
  107.     "MSGTEXT" "MSGEXPLAN"))
  108.  
  109. (define list-list
  110.   (list "ORDEREDLIST" "ITEMIZEDLIST" "VARIABLELIST" "SEGMENTEDLIST"
  111.         "SIMPLELIST" "CALLOUTLIST" "STEP"))
  112.  
  113. (define (SECTLEVEL)
  114.   (cond
  115.    ((have-ancestor? "SECT5") 5)
  116.    ((have-ancestor? "SECT4") 4)
  117.    ((have-ancestor? "SECT3") 3)
  118.    ((have-ancestor? "SECT2") 2)
  119.    ((have-ancestor? "SECT1") 1)
  120.    ((have-ancestor? "REFERENCE") 1)
  121.    (else 0))) ;; 0 is the component (chapter/appendix) level
  122.  
  123. (define (OLSTEP)
  124.   (case
  125.    (modulo (length (hierarchical-number-recursive "ORDEREDLIST")) 4)
  126.     ((1) 1.2em)
  127.     ((2) 1.2em)
  128.     ((3) 1.6em)
  129.     ((0) 1.4em)))
  130.  
  131. (define (ILSTEP) 1.0em)
  132.  
  133. (define (PROCSTEP ilvl)
  134.   (if (> ilvl 1) 1.8em 1.4em))
  135.  
  136. (define (PROCWID ilvl)
  137.   (if (> ilvl 1) 1.8em 1.4em))
  138.  
  139. ;; ======================= NON-PRINTING ELEMENTS ========================
  140.  
  141. ;; ................................ META ................................
  142.  
  143. (element COMMENT (empty-sosofo))
  144. (element TITLEABBREV (empty-sosofo))
  145. (element SUBTITLE (empty-sosofo))
  146. (element SETINFO (empty-sosofo))
  147. (element BOOKINFO (empty-sosofo))
  148. (element BIBLIOENTRY (empty-sosofo))
  149. (element BIBLIOMISC (empty-sosofo))
  150. (element BOOKBIBLIO (empty-sosofo))
  151. (element SERIESINFO (empty-sosofo))
  152. (element DOCINFO (empty-sosofo))
  153. (element ARTHEADER (empty-sosofo))
  154.  
  155. ;; ......................... BIBLIOGRAPHIC DATA .........................
  156.  
  157. (element ACKNO (empty-sosofo))
  158. (element ADDRESS (empty-sosofo))
  159. (element STREET (empty-sosofo))
  160. (element POB (empty-sosofo))
  161. (element POSTCODE (empty-sosofo))
  162. (element CITY (empty-sosofo))
  163. (element STATE (empty-sosofo))
  164. (element COUNTRY (empty-sosofo))
  165. (element PHONE (empty-sosofo))
  166. (element FAX (empty-sosofo))
  167. (element OTHERADDR (empty-sosofo))
  168. (element AFFILIATION (empty-sosofo))
  169. (element SHORTAFFIL (empty-sosofo))
  170. (element JOBTITLE (empty-sosofo))
  171. (element ORGDIV (empty-sosofo))
  172. (element ARTPAGENUMS (empty-sosofo))
  173. (element AUTHOR (empty-sosofo))
  174. (element AUTHORGROUP (empty-sosofo))
  175. (element COLLAB (empty-sosofo))
  176. (element COLLABNAME (empty-sosofo))
  177. (element AUTHORINITIALS (empty-sosofo))
  178. (element CONFGROUP (empty-sosofo))
  179. (element CONFDATES (empty-sosofo))
  180. (element CONFTITLE (empty-sosofo))
  181. (element CONFNUM (empty-sosofo))
  182. (element CONFSPONSOR (empty-sosofo))
  183. (element CONTRACTNUM (empty-sosofo))
  184. (element CONTRACTSPONSOR (empty-sosofo))
  185. (element COPYRIGHT (empty-sosofo))
  186. (element YEAR (empty-sosofo))
  187. (element HOLDER (empty-sosofo))
  188. (element CORPAUTHOR (empty-sosofo))
  189. (element CORPNAME (empty-sosofo))
  190. (element DATE (empty-sosofo))
  191. (element EDITION (empty-sosofo))
  192. (element EDITOR (empty-sosofo))
  193. (element ISBN (empty-sosofo))
  194. (element ISSN (empty-sosofo))
  195. (element INVPARTNUMBER (empty-sosofo))
  196. (element ISSUENUM (empty-sosofo))
  197. (element LEGALNOTICE (empty-sosofo))
  198. (element MODESPEC (empty-sosofo))
  199. (element ORGNAME (empty-sosofo))
  200. (element OTHERCREDIT (empty-sosofo))
  201. (element PAGENUMS (empty-sosofo))
  202. (element CONTRIB (empty-sosofo))
  203. (element FIRSTNAME (empty-sosofo))
  204. (element HONORIFIC (empty-sosofo))
  205. (element LINEAGE (empty-sosofo))
  206. (element OTHERNAME (empty-sosofo))
  207. (element SURNAME (empty-sosofo))
  208. (element PRINTHISTORY (empty-sosofo))
  209. (element PRODUCTNAME (empty-sosofo))
  210. (element PRODUCTNUMBER (empty-sosofo))
  211. (element PUBDATE (empty-sosofo))
  212. (element PUBLISHER (empty-sosofo))
  213. (element PUBLISHERNAME (empty-sosofo))
  214. (element PUBSNUMBER (empty-sosofo))
  215. (element RELEASEINFO (empty-sosofo))
  216. (element REVHISTORY (empty-sosofo))
  217. (element REVISION (empty-sosofo))
  218. (element REVNUMBER (empty-sosofo))
  219. (element REVREMARK (empty-sosofo))
  220. (element SERIESVOLNUMS (empty-sosofo))
  221. (element VOLUMENUM (empty-sosofo))
  222.  
  223. ;; ................... INDEX TERMS (EMBEDDED MARKERS) ...................
  224.  
  225. (element INDEXTERM (empty-sosofo))
  226. (element PRIMARY (empty-sosofo))
  227. (element SECONDARY (empty-sosofo))
  228. (element TERTIARY (empty-sosofo))
  229. (element SEE (empty-sosofo))
  230. (element SEEALSO (empty-sosofo))
  231.  
  232.  
  233. ;; ============================= DIVISIONS ==============================
  234.  
  235. (define ($divtitlepage$)
  236.   (make simple-page-sequence
  237.     top-margin: %top-margin%
  238.     bottom-margin: %bottom-margin%
  239.     left-margin: %left-right-margin%
  240.     right-margin: %left-right-margin%
  241.     input-whitespace-treatment: 'collapse
  242.     (make paragraph
  243.           font-family-name: %title-font-family%
  244.           font-weight: 'bold
  245.           font-size: (HSIZE 5)
  246.           line-spacing: (* (HSIZE 5) %line-spacing-factor%)
  247.           space-before: (* (HSIZE 5) %head-before-factor%)
  248.           space-after: (* (HSIZE 5) %head-after-factor% 4)
  249.           quadding: 'start
  250.           keep-with-next?: #t
  251.           (process-children-trim))))
  252.  
  253. (element (SET TITLE) ($divtitlepage$))
  254. (element (BOOK TITLE) ($divtitlepage$))
  255. (element (ARTHEADER TITLE) ($divtitlepage$))
  256. (element (PART TITLE) ($divtitlepage$))
  257.  
  258. ;; ============================= COMPONENTS =============================
  259. ;;
  260. ;; in docbook, components are containers at the chapter/appendix level
  261.  
  262. (define ($component$)
  263.   (let ((page-header
  264.          (make sequence
  265.            use: para-style
  266.            font-posture: 'italic
  267.            (with-mode hf-mode (process-first-descendant "TITLE"))))
  268.     (page-footer
  269.          (make sequence
  270.            use: para-style
  271.            font-posture: 'italic
  272.            (literal 
  273.         (string-append
  274.          "Page "
  275.          (cond
  276.           ((equal? (gi) "CHAPTER")
  277.            (format-number (element-number) "1"))
  278.           ((equal? (gi) "APPENDIX")
  279.            (format-number (element-number) "A"))
  280.           ((equal? (gi) "GLOSSARY") "Glossary")
  281.           ((equal? (gi) "PREFACE") "Preface")
  282.           (else ""))
  283.          "-"))
  284.            (page-number-sosofo))))
  285.     (make simple-page-sequence
  286.       page-number-restart?: #t
  287.       use: para-style
  288.       start-indent: %body-start-indent%
  289.       left-header:  (if-front-page (empty-sosofo) page-header)
  290.       right-header: (if-front-page page-header (empty-sosofo))
  291.       left-footer:     (if-front-page (empty-sosofo) page-footer)
  292.       right-footer: (if-front-page page-footer (empty-sosofo))
  293.       top-margin: %top-margin%
  294.       bottom-margin: %bottom-margin%
  295.       left-margin: %left-right-margin%
  296.       right-margin: %left-right-margin%
  297.       header-margin: %header-margin%
  298.       footer-margin: %footer-margin%
  299.       page-width: %page-width%
  300.       page-height: %page-height%
  301.       input-whitespace-treatment: 'collapse
  302.       quadding: 'start
  303.       (process-children-trim))))
  304.  
  305. ;; this is how we prevent the title in the header from acquiring the
  306. ;;   display treatment that it receives in the body of the document
  307. ;;
  308. (mode hf-mode
  309.   (element TITLE
  310.        (make sequence
  311.          (literal
  312.           (cond ((have-ancestor? "CHAPTER")
  313.              (CHAP-APP-HEAD-LABEL "Chapter"))
  314.             ((have-ancestor? "APPENDIX")
  315.              (CHAP-APP-HEAD-LABEL "Appendix"))
  316.             (else "")))
  317.          (process-children-trim))))
  318.  
  319. (define ($comptitle$)
  320.   (make paragraph
  321.     font-family-name: %title-font-family%
  322.     font-weight: 'bold
  323.     font-size: (HSIZE 4)
  324.     line-spacing: (* (HSIZE 4) %line-spacing-factor%)
  325.     space-before: (* (HSIZE 4) %head-before-factor%)
  326.     space-after: (* (HSIZE 4) %head-after-factor%)
  327.     start-indent: 0pt
  328.     first-line-start-indent: 0pt
  329.     quadding: 'start
  330.     keep-with-next?: #t
  331.     (literal
  332.       (cond ((have-ancestor? "CHAPTER")
  333.          (CHAP-APP-HEAD-LABEL "Chapter"))
  334.         ((have-ancestor? "APPENDIX")
  335.          (CHAP-APP-HEAD-LABEL "Appendix"))
  336.         (else "")))
  337.     (process-children-trim)))
  338.  
  339. (define (CHAP-APP-HEAD-LABEL chap-or-app)
  340.   (let ((label
  341.      (attribute-string "label" (ancestor chap-or-app))))
  342.     (string-append 
  343.      chap-or-app
  344.      " "
  345.      (if label
  346.      (if (equal? label "auto")
  347.          (format-number
  348.           (element-number (ancestor chap-or-app))
  349.           (if (equal? chap-or-app "Chapter") "1" "A"))
  350.        label)
  351.        (format-number
  352.     (element-number (ancestor chap-or-app))
  353.     (if (equal? chap-or-app "Chapter") "1" "A")))
  354.      ". ")))
  355.  
  356. (element APPENDIX ($component$))
  357. (element (APPENDIX TITLE) ($comptitle$))
  358. (element CHAPTER ($component$))
  359. (element (CHAPTER TITLE) ($comptitle$))
  360. (element PREFACE ($component$))
  361. (element (PREFACE TITLE) ($comptitle$))
  362. (element REFERENCE ($component$))
  363. (element (REFERENCE TITLE) ($comptitle$))
  364. (element BIBLIOGRAPHY ($component$))
  365. (element (BIBLIOGRAPHY TITLE) ($comptitle$))
  366. (element GLOSSARY ($component$))
  367. (element (GLOSSARY TITLE) ($comptitle$))
  368. (element INDEX ($component$))
  369. (element (INDEX TITLE) ($comptitle$))
  370. (element SETINDEX ($component$))
  371. (element (SETINDEX TITLE) ($comptitle$))
  372.  
  373. ;; need test cases to do toc/lot; do these later
  374.  
  375. (element TOC ($component$))
  376. (element (TOC TITLE) ($comptitle$))
  377. (element TOCFRONT ($paragraph$))
  378. (element TOCENTRY ($paragraph$))
  379. (element TOCPART (process-children))
  380. (element TOCCHAP (process-children))
  381. (element TOCLEVEL1 (process-children))
  382. (element TOCLEVEL2 (process-children))
  383. (element TOCLEVEL3 (process-children))
  384. (element TOCLEVEL4 (process-children))
  385. (element TOCLEVEL5 (process-children))
  386. (element TOCBACK ($paragraph$))
  387. (element LOT ($component$))
  388. (element (LOT TITLE) ($comptitle$))
  389. (element LOTENTRY ($paragraph$))
  390.  
  391.  
  392. ;; ============================== SECTIONS ==============================
  393.  
  394. (define ($section$) ($block-container$))
  395. (define ($sectitle$)
  396.   (let* ((renderas (inherited-attribute-string "renderas"))
  397.      (hlevel                         ;; the apparent section level;
  398.        (if renderas                  ;; if not real section level,
  399.          (string->number             ;;   then get the apparent level
  400.            (substring renderas 4 5)) ;;   from "renderas",
  401.          (SECTLEVEL)))               ;; else use the real level
  402.     (hs (HSIZE (- 4 hlevel)))
  403.     (label (attribute-string "label")))
  404.   (make paragraph
  405.     font-family-name: %title-font-family%
  406.     font-weight:  (if (< hlevel 5) 'bold 'medium)
  407.     font-posture: (if (< hlevel 5) 'upright 'italic)
  408.     font-size: hs
  409.     line-spacing: (* hs %line-spacing-factor%)
  410.     space-before: (* hs %head-before-factor%)
  411.     space-after: (* hs %head-after-factor%)
  412.     start-indent:
  413.       (if (< hlevel 3)
  414.           0pt
  415.           %body-start-indent%)
  416.     first-line-start-indent: 0pt
  417.     quadding: 'start
  418.     keep-with-next?: #t
  419.     (literal
  420.      (if label
  421.          (if (equal? label "AUTO")
  422.          (let ((chn (ancestor-child-number "CHAPTER"))
  423.                (apn (ancestor-child-number "APPENDIX"))
  424.                (s1n (ancestor-child-number "SECT1"))
  425.                (s2n (ancestor-child-number "SECT2"))
  426.                (s3n (ancestor-child-number "SECT3"))
  427.                (s4n (ancestor-child-number "SECT4"))
  428.                (s5n (ancestor-child-number "SECT5")))
  429.            (string-append
  430.             (cond
  431.              (chn (FNUM chn))
  432.              (apn (FNUM apn))
  433.              (else "X"))
  434.             (if s1n (string-append "." (FNUM s1n)) " ")
  435.             (if s2n (string-append "." (FNUM s2n)) " ")
  436.             (if s3n (string-append "." (FNUM s3n)) " ")
  437.             (if s4n (string-append "." (FNUM s4n)) " ")
  438.             (if s5n (string-append "." (FNUM s5n)) " ")))
  439.          (string-append label " "))
  440.       (string-append "")))
  441.     (process-children-trim))))
  442.  
  443. (element SECT1 ($section$))
  444. (element (SECT1 TITLE) ($sectitle$))
  445. (element SECT2 ($section$))
  446. (element (SECT2 TITLE) ($sectitle$))
  447. (element SECT3 ($section$))
  448. (element (SECT3 TITLE) ($sectitle$))
  449. (element SECT4 ($section$))
  450. (element (SECT4 TITLE) ($sectitle$))
  451. (element SECT5 ($section$))
  452. (element (SECT5 TITLE) ($sectitle$))
  453.  
  454. (element SIMPLESECT ($section$))
  455. (element (SIMPLESECT TITLE) ($sectitle$))
  456.  
  457. (element PARTINTRO ($section$))
  458. (element (PARTINTRO TITLE) ($sectitle$))
  459.  
  460. (element BIBLIODIV ($section$))
  461. (element (BIBLIODIV TITLE) ($sectitle$))
  462. (element GLOSSDIV ($section$))
  463. (element (GLOSSDIV TITLE) ($sectitle$))
  464. (element INDEXDIV ($section$))
  465. (element (INDEXDIV TITLE) ($sectitle$))
  466.  
  467.  
  468. ;; =========================== REFERENCE PAGES ==========================
  469.  
  470. (element REFENTRY ($block-container$))
  471.  
  472. (element REFMETA
  473.   (let* ((slevel (SECTLEVEL)) ;; the true level in the section hierarchy
  474.      (hlevel (if (> slevel 2) 2 slevel)) ;; limit to sect2 equiv.
  475.      (hs (HSIZE (- 4 hlevel))))
  476.     (make paragraph
  477.       font-family-name: %title-font-family%
  478.       font-weight: 'bold
  479.       font-size: hs
  480.       line-spacing: (* hs %line-spacing-factor%)
  481.       space-before: (* hs %head-before-factor%)
  482.       space-after: (* hs %head-after-factor%)
  483.       start-indent: %body-start-indent%
  484.       first-line-start-indent: (- %body-start-indent%)
  485.       quadding: 'start
  486.       keep-with-next?: #t
  487.       (process-first-descendant "REFENTRYTITLE")
  488.       (literal " (")
  489.       (process-first-descendant "MANVOLNUM")
  490.       (literal ")"))))
  491.  
  492. (element REFMISCINFO (empty-sosofo)) ;; *** TO DO: finish this
  493.  
  494. (element REFNAMEDIV
  495.   (make paragraph
  496.     use: para-style
  497.     space-before: %para-sep%
  498.     start-indent: %body-start-indent%
  499.     quadding: 'start
  500.     (process-children)))
  501.  
  502. (element REFNAME
  503.   (make sequence
  504.     (make sequence
  505.       font-weight: 'bold
  506.       (literal "NAME"))
  507.     (make sequence
  508.       font-weight: 'medium
  509.       font-family-name: %mono-font-family%
  510.       (literal " ")
  511.       (process-children)
  512.       (literal " "))))
  513.  
  514. (element REFPURPOSE
  515.   (make sequence
  516.     font-family-name: %body-font-family%
  517.     (make sequence
  518.       (literal "-- ")
  519.       (process-children))
  520.     (make paragraph-break)))
  521.     
  522. (element REFDESCRIPTOR (empty-sosofo)) ;; TO DO: finish this
  523.  
  524. (element REFCLASS
  525.   (let ((role (attribute-string "role")))
  526.     (make paragraph
  527.       use: para-style
  528.       space-before: %para-sep%
  529.       start-indent: %body-start-indent%
  530.       quadding: 'start
  531.       (make sequence
  532.         font-weight: 'bold
  533.         (literal
  534.           (if role
  535.               (string-append role ": ")
  536.               "")))
  537.       (process-children-trim))))
  538.  
  539. (element REFSYNOPSISDIV
  540.   (make paragraph
  541.     use: para-style
  542.     space-before: %para-sep%
  543.     start-indent: %body-start-indent%
  544.     lines: 'asis
  545.     font-family-name: %mono-font-family%
  546.     (process-children)))
  547.  
  548. (element (REFSYNOPSISDIV TITLE) ($lowtitle$ 1))
  549. (element REFSECT1 ($block-container$))
  550. (element (REFSECT1 TITLE) ($lowtitle$ 1))
  551. (element REFSECT2 ($block-container$))
  552. (element (REFSECT2 TITLE) ($lowtitle$ 2))
  553. (element REFSECT3 ($block-container$))
  554. (element (REFSECT3 TITLE) ($lowtitle$ 3))
  555.  
  556.  
  557. ;; ======================== ERROR MESSAGES (ETC.) =======================
  558.  
  559. (element MSGSET (process-children))
  560.  
  561. (element MSGENTRY ($block-container$))
  562.  
  563. (element MSG
  564.   (make display-group
  565.     font-weight: 'bold
  566.     font-family-name: %mono-font-family%
  567.     (process-children)))
  568.  
  569. (element MSGMAIN (process-children))
  570.  
  571. (element MSGSUB
  572.   (make display-group
  573.     start-indent: (+ (inherited-start-indent) (ILSTEP))
  574.     (process-children)))
  575.  
  576. (element MSGREL
  577.   (make display-group
  578.     font-weight: 'bold
  579.     (process-children)))
  580.  
  581. (element MSGTEXT (process-children))
  582.  
  583. (element MSGINFO ($indent-para-container$))
  584.  
  585. (define ($genhead-para$ headtext)
  586.   (make paragraph
  587.     space-before: %para-sep%
  588.     space-after: %para-sep%
  589.     (make sequence
  590.           font-weight: 'bold
  591.           (literal
  592.             (string-append headtext ": ")))
  593.     (process-children)))
  594.  
  595. (element MSGLEVEL ($genhead-para$ "Level"))
  596. (element MSGORIG ($genhead-para$ "Origin"))
  597. (element MSGAUD ($genhead-para$ "Audience"))
  598.  
  599. (element MSGEXPLAN ($indent-para-container$))
  600. (element (MSGEXPLAN TITLE) ($runinhead$))
  601. (element (MSGEXPLAN PARA) (make sequence (process-children)))
  602.  
  603.  
  604. ;; ================= UNCLASSIFIED BLOCK-LEVEL ELEMENTS ==================
  605.  
  606. (element TITLE ($lowtitle$ 2))         ;; the default TITLE format
  607. (element BRIDGEHEAD ($lowtitle$ 2))
  608.  
  609. (element SIDEBAR ($block-container$))
  610. (element ABSTRACT ($block-container$))
  611. (element AUTHORBLURB ($block-container$))
  612.  
  613. (element BLOCKQUOTE
  614.   (make paragraph
  615.     font-size: (* %bf-size% %smaller-size-factor%)
  616.     line-spacing: (* %bf-size% %line-spacing-factor%
  617.              %smaller-size-factor%)
  618.     space-before: %para-sep%
  619.     start-indent: (+ %body-start-indent% 1em)
  620.     end-indent: 1em
  621.     (process-children-trim)))
  622.  
  623. (element ATTRIBUTION ($paragraph$))
  624. (element EPIGRAPH ($block-container$))
  625. (element FOOTNOTE (empty-sosofo)) ;; can't deal with this yet -- revisit
  626. (element HIGHLIGHTS ($block-container$))
  627.  
  628. (element FORMALPARA ($para-container$))
  629. (element (FORMALPARA TITLE) ($runinhead$))
  630. (element (FORMALPARA PARA) (make sequence (process-children)))
  631.  
  632. (element PARA ($paragraph$))
  633. (element SIMPARA ($paragraph$))
  634.  
  635. (element (ROW ENTRY PARA)
  636.   (make paragraph
  637.     use: para-style
  638.     (process-children-trim)))
  639.  
  640. (element (THEAD ROW ENTRY PARA)
  641.   (make paragraph
  642.     font-size: %bf-size%
  643.     font-family-name: %title-font-family%
  644.     font-weight: 'bold
  645.     line-spacing: (* %bf-size% %line-spacing-factor%)
  646.     quadding: 'start
  647.     (process-children-trim)))
  648.  
  649. ;; ============================ ADMONITIONS =============================
  650.  
  651. (define ($admonition$)
  652.   (make display-group
  653.     space-before: %block-sep%
  654.     space-after: %block-sep%
  655.     (process-children)))
  656.  
  657. (define ($admonpara$)
  658.   (make paragraph
  659.     space-before: %para-sep%
  660.     space-after: %para-sep%
  661.     font-size: (- %bf-size% 1pt)
  662.     font-weight: 'medium
  663.     font-posture: 'upright
  664.     font-family-name: %admon-font-family%
  665.     line-spacing: (* (- %bf-size% 1pt) %line-spacing-factor%)
  666.     start-indent: (+ (inherited-start-indent) (* (ILSTEP) 2))
  667.     (make sequence
  668.           font-family-name: %title-font-family%
  669.           font-weight: 'bold
  670.           (literal
  671.            (if (= (child-number) 1)
  672.            (cond
  673.              ((have-ancestor? "IMPORTANT") "IMPORTANT: ")
  674.              ((have-ancestor? "NOTE") "NOTE: ")
  675.              ((have-ancestor? "TIP") "TIP: ")
  676.              (else ""))
  677.            "")))
  678.     (process-children)))
  679.  
  680. (element IMPORTANT ($admonition$))
  681. (element (IMPORTANT PARA) ($admonpara$))
  682. (element NOTE ($admonition$))
  683. (element (NOTE PARA) ($admonpara$))
  684. (element TIP ($admonition$))
  685. (element (TIP PARA) ($admonpara$))
  686.  
  687. ;; perils are given special treatment by generating a centered title
  688. ;;   and throwing a box around them
  689. ;; note that the paragraph indents are set by the box characteristics
  690. ;;
  691. (define ($peril$)
  692.   (let ((hs (HSIZE 2)))
  693.     (make display-group
  694.       space-before: %block-sep%
  695.       space-after: %block-sep%
  696.       (make box
  697.         display?: #t
  698.         box-type: 'border
  699.         line-thickness: 2pt
  700.         start-indent: (+ (inherited-start-indent) (* 2 (ILSTEP)) 2pt)
  701.         end-indent: (inherited-end-indent)
  702.         (make paragraph
  703.               space-before: %para-sep%
  704.               space-after: %para-sep%
  705.               start-indent: 1em
  706.               end-indent: 1em
  707.               font-family-name: %title-font-family%
  708.               font-weight: 'bold
  709.               font-size: hs
  710.               line-spacing: (* hs %line-spacing-factor%)
  711.               quadding: 'center
  712.               keep-with-next?: #t
  713.               (literal
  714.                 (cond
  715.               ((equal? (gi) "CAUTION") "CAUTION")
  716.               ((equal? (gi) "WARNING") "WARNING")
  717.               (else ""))))
  718.         (process-children)))))
  719.  
  720. (element CAUTION ($peril$))
  721. (element WARNING ($peril$))
  722.  
  723. ;; ========================= GLOSSARY ELEMENTS ==========================
  724.  
  725. (element GLOSSLIST ($block-container$))
  726. (element GLOSSENTRY ($para-container$))
  727.  
  728. (element GLOSSTERM ($lowtitle$ 3))
  729. (element GLOSSDEF ($indent-para-container$))
  730.  
  731. (element GLOSSSEE ($italic-seq$))
  732. (element GLOSSSEEALSO ($italic-seq$))
  733.  
  734.  
  735. ;; =============================== LISTS ================================
  736.  
  737.  
  738. (define ($list$)
  739.  (make display-group
  740.        space-before: (if (INLIST?) %para-sep% %block-sep%)
  741.        space-after:  (if (INLIST?) %para-sep% %block-sep%)))
  742.  
  743. (element ITEMIZEDLIST ($list$))
  744.  
  745. (element (ITEMIZEDLIST LISTITEM)
  746.   (make paragraph
  747.     start-indent: (+ (inherited-start-indent) (ILSTEP))
  748.     (process-children)))
  749.  
  750. (element (ITEMIZEDLIST LISTITEM PARA)
  751.   (let ((spacing (inherited-attribute-string "spacing")))
  752.     (if (= (child-number) 1)
  753.       (let ((ilevel 
  754.           (length (hierarchical-number-recursive "ITEMIZEDLIST")))
  755.         (override
  756.           (inherited-attribute-string "override"))
  757.         (spacing
  758.           (inherited-attribute-string "spacing"))
  759.         (mark
  760.           (inherited-attribute-string "mark")))
  761.     (make paragraph
  762.           use: para-style
  763.           space-before: (if (equal? "COMPACT" spacing)
  764.                 0pt
  765.                   %para-sep%)
  766.           first-line-start-indent: (- (ILSTEP))
  767.           (make line-field
  768.             font-family-name:
  769.               (BULLTREAT BULLFONT ilevel override mark)
  770.             font-size:
  771.               (BULLTREAT BULLSIZE ilevel override mark)
  772.             position-point-shift:
  773.               (BULLTREAT BULLSHIFT ilevel override mark)
  774.             field-width: (ILSTEP)
  775.             (literal
  776.               (BULLTREAT BULLSTR ilevel override mark)))
  777.           (make sequence
  778.             first-line-start-indent: 0pt
  779.             (process-children-trim))))
  780.     (make paragraph
  781.       use: para-style
  782.       space-before: (if (equal? "COMPACT" spacing)
  783.                 0pt
  784.               %para-sep%)
  785.       (process-children-trim)))))
  786.  
  787. (element ORDEREDLIST ($list$))
  788.  
  789. (element (ORDEREDLIST LISTITEM)
  790.   (make paragraph
  791.     start-indent: (+ (inherited-start-indent) (OLSTEP))
  792.     (process-children)))
  793.  
  794. (element (ORDEREDLIST LISTITEM PARA)
  795.   (let ((spacing (inherited-attribute-string "spacing")))
  796.     (if (= (child-number) 1)
  797.       (make paragraph
  798.         use: para-style
  799.         space-before: (if (equal? "COMPACT" spacing)
  800.                   0pt
  801.                 %para-sep%)
  802.        first-line-start-indent: (- (OLSTEP))
  803.        (make line-field
  804.          field-width: (OLSTEP)
  805.          (literal
  806.           (case (modulo (length
  807.         (hierarchical-number-recursive "ORDEREDLIST")) 4)
  808.             ((1) (string-append
  809.               (format-number (PARNUM) "1") "."))
  810.             ((2) (string-append 
  811.               (format-number (PARNUM) "a") "."))
  812.             ((3) (string-append
  813.               "(" (format-number (PARNUM) "i") ")"))
  814.             ((0) (string-append
  815.               "(" (format-number (PARNUM) "a") ")")))))
  816.        (make sequence
  817.          first-line-start-indent: 0pt
  818.        (process-children-trim)))
  819.     (make paragraph
  820.       use: para-style
  821.       space-before: (if (equal? "COMPACT" spacing)
  822.                 0pt
  823.               %para-sep%)
  824.       (process-children-trim)))))
  825.  
  826. (element VARIABLELIST ($list$))
  827. (element VARLISTENTRY ($para-container$))
  828. (element (VARLISTENTRY TERM)
  829.   (let ((termlength
  830.       (attribute-string "termlength" (ancestor "VARIABLELIST"))))
  831.     (make paragraph
  832.       use: para-style
  833.       space-before: %para-sep%
  834.       end-indent: (if termlength
  835.               (- %text-width% (PARSEDUNIT termlength))
  836.               0pt)
  837.       (process-children-trim))))
  838. (element (VARLISTENTRY LISTITEM PARA)
  839.   (make paragraph
  840.     use: para-style
  841.     space-before: %para-sep%
  842.     space-after: %para-sep%
  843. ;; eliding the following corrects an indentation problem,
  844. ;;  according to drepper -- eichin 19970904
  845. ;;    start-indent: (+ (inherited-start-indent) 2em)
  846. ;; end of elision
  847.     (process-children-trim)))
  848.  
  849. (element SIMPLELIST ($list$))
  850. (element MEMBER
  851.   (make paragraph
  852.     start-indent: (+ (inherited-start-indent) (ILSTEP))
  853.     (process-children)))
  854.  
  855. ;; TO DO: deal with these
  856.  
  857. (element SEGMENTEDLIST (process-children))
  858. (element (SEGMENTEDLIST TITLE) ($lowtitle$ 2))
  859. (element SEGTITLE ($paragraph$))
  860. (element SEGLISTITEM ($paragraph$))
  861. (element SEG ($paragraph$))
  862. (element CALLOUTLIST (process-children))
  863. (element (CALLOUTLIST TITLE) ($lowtitle$ 2))
  864. (element CALLOUT ($paragraph$))
  865.  
  866.  
  867. ;; ============================= PROCEDURES =============================
  868.  
  869. (element PROCEDURE ($list$))
  870. (element (PROCEDURE TITLE) ($lowtitle$ 2))
  871.  
  872. (element SUBSTEPS
  873.   (make display-group
  874.     space-before: %para-sep%
  875.     space-after: %para-sep%
  876.     start-indent: (+ (inherited-start-indent) (PROCSTEP 2))))
  877.  
  878. (element (STEP PARA)
  879.   (let ((ilevel 
  880.      (length (hierarchical-number-recursive "STEP"))))
  881.     (if (= (child-number) 1)
  882.     (make paragraph
  883.           use: para-style
  884.           space-before: %para-sep%
  885.           start-indent: (+ (inherited-start-indent)
  886.                    (PROCSTEP ilevel))
  887.           first-line-start-indent: (- (PROCSTEP ilevel))
  888.           font-weight: 'bold
  889.           (make line-field
  890.             field-width: (PROCSTEP ilevel)
  891.             (literal
  892.              (if (= 1 ilevel)
  893.              (string-append 
  894.               (format-number
  895.                (ancestor-child-number "STEP") "1") ".")
  896.                  (string-append
  897.               (format-number
  898.                (list-ref
  899.                 (hierarchical-number-recursive "STEP")
  900.                 (- ilevel 2)) "1")
  901.               (format-number
  902.                (ancestor-child-number "STEP") "a") "."))))
  903.           (make sequence
  904.             first-line-start-indent: 0pt
  905.             (process-children-trim)))
  906.     (make paragraph
  907.       use: para-style
  908.       space-before: %para-sep%
  909.       start-indent: (+ (inherited-start-indent) (PROCSTEP ilevel))
  910.       (process-children-trim)))))
  911.  
  912. ;; ======================= EXAMPLES AND LISTINGS ========================
  913.  
  914. (element EXAMPLE ($block-container$))
  915. (element (EXAMPLE TITLE) ($lowtitle$ 2))
  916. (element INFORMALEXAMPLE ($block-container$))
  917.  
  918. (define ($verbatim-display$)
  919.   (let* ((width-in-chars
  920.       (if (attribute-string "width")
  921.           (string->number (attribute-string "width"))
  922.         60)) ;; the default is a maximum line length of 60 chars
  923.      (fsize (lambda () (/ (/ (- %text-width% (inherited-start-indent))
  924.          width-in-chars) 0.7))))
  925.     (make paragraph
  926.       space-before: (if (INLIST?) %para-sep% %block-sep%)
  927.       space-after:  (if (INLIST?) %para-sep% %block-sep%)
  928.       font-family-name: %mono-font-family%
  929.       font-size: (fsize)
  930.       font-weight: 'medium
  931.       font-posture: 'upright
  932.       line-spacing: (* (fsize) %line-spacing-factor%)
  933.       lines: 'asis
  934.           input-whitespace-treatment: 'preserve
  935.       quadding: 'start
  936.       (process-children))))
  937.  
  938. (element LITERALLAYOUT ($verbatim-display$))
  939. (element PROGRAMLISTING ($verbatim-display$))
  940. (element SCREEN ($verbatim-display$))
  941.  
  942. ;; screenshot is a graphic with possible screeninfo
  943. ;; *** TO DO: deal with this
  944. (element SCREENSHOT (process-children))
  945.  
  946. ;; screenco can have children areaspec, screen, calloutlist
  947. ;; programlistingco can have children areaspec, programlisting, calloutlist
  948. ;; don't know how to deal with these yet
  949. ;; *** TO DO: deal with these
  950. (element SCREENINFO ($paragraph$))
  951. (element AREASPEC ($paragraph$))
  952. (element AREA ($paragraph$))
  953. (element AREASET ($paragraph$))
  954.  
  955. (element PROGRAMLISTINGCO (process-children))
  956. (element SCREENCO (process-children))
  957.  
  958. ;; ==================== FIGURES, GRAPHICS, EQUATIONS ====================
  959.  
  960. (element FIGURE 
  961.   (make display-group
  962.     (with-mode figure-caption-mode
  963.            (process-first-descendant "TITLE"))
  964.     (process-children)))
  965.  
  966. (element GRAPHIC ($image$))
  967. (element INLINEGRAPHIC ($image$))
  968.  
  969. (define ($image$)
  970.   (let ((fileref (attribute-string "fileref"))
  971.     (entityref (attribute-string "entityref")))
  972.     (make paragraph
  973.       space-before: %block-sep%
  974.       space-after: %block-sep%
  975.       (make external-graphic
  976.         entity-system-id: (if fileref fileref
  977.                     (if entityref 
  978.                     (entity-generated-system-id entityref)
  979.                       ""))
  980.         display?: #t
  981.         display-alignment: 'start))))
  982.  
  983. (mode figure-caption-mode
  984.   (element TITLE
  985.     (let ((label (attribute-string "label" (ancestor "figure"))))
  986.       (make paragraph
  987.         use: para-style
  988.         font-weight: 'bold
  989.         space-before: %block-sep%
  990.         space-after: %para-sep%
  991.         keep-with-next?: #t
  992.         (literal
  993.          (string-append
  994.           "Figure "
  995.           (if label
  996.           label
  997.         (format-number (element-number (parent (current-node))) "1"))
  998.           ". "))
  999.         (process-children-trim)))))
  1000.  
  1001. (element (FIGURE TITLE) (empty-sosofo)) ; don't show caption below figure
  1002.  
  1003. ;; *** TO DO: deal with these
  1004. (element GRAPHICCO (process-children))
  1005. (element EQUATION (process-children))
  1006. (element (EQUATION TITLE) ($lowtitle$ 2))
  1007. (element INFORMALEQUATION (process-children))
  1008. (element INLINEEQUATION (process-children))
  1009.  
  1010.  
  1011. ;; ========================= SYNTAX DEFINITIONS =========================
  1012. ;; *** TO DO: this is just a placeholder; need examples to define styles
  1013.  
  1014. (element SYNOPSIS (process-children))
  1015. (element CMDSYNOPSIS (process-children))
  1016. (element ARG ($paragraph$))
  1017. (element GROUP ($paragraph$))
  1018. (element SBR ($paragraph$))
  1019. (element SYNOPFRAGMENTREF ($paragraph$))
  1020. (element SYNOPFRAGMENT (process-children))
  1021. (element FUNCSYNOPSIS (process-children))
  1022. (element FUNCSYNOPSISINFO (process-children))
  1023. (element FUNCPROTOTYPE (process-children))
  1024. (element FUNCDEF ($paragraph$))
  1025. (element VOID ($paragraph$))
  1026. (element VARARGS (process-children))
  1027. (element PARAMDEF (process-children))
  1028. (element FUNCPARAMS (process-children))
  1029.  
  1030.  
  1031. ;; ============================== INLINES ===============================
  1032.  
  1033. (element ACCEL ($charseq$))
  1034. (element ACTION ($charseq$))
  1035. (element APPLICATION ($charseq$))
  1036. (element CLASSNAME ($charseq$))
  1037. (element COMMAND ($bold-seq$))
  1038. (element COMPUTEROUTPUT ($mono-seq$))
  1039. (element DATABASE ($charseq$))
  1040. (element EMAIL ($charseq$))
  1041. (element ERRORNAME ($charseq$))
  1042. (element ERRORTYPE ($charseq$))
  1043. (element FILENAME ($charseq$))
  1044. (element FUNCTION ($bold-seq$))
  1045. (element GUIBUTTON ($charseq$))
  1046. (element GUIICON ($charseq$))
  1047. (element GUILABEL ($charseq$))
  1048. (element GUIMENU ($charseq$))
  1049. (element GUIMENUITEM ($charseq$))
  1050. (element GUISUBMENU ($charseq$))
  1051. (element HARDWARE ($charseq$))
  1052. (element INTERFACE ($charseq$))
  1053. (element INTERFACEDEFINITION ($charseq$))
  1054. (element KEYCAP ($bold-seq$))
  1055. (element KEYCODE ($charseq$))
  1056. (element KEYCOMBO ($charseq$))
  1057. (element KEYSYM ($charseq$))
  1058. (element LITERAL ($mono-seq$))
  1059. (element MEDIALABEL ($italic-seq$))
  1060. (element MENUCHOICE ($charseq$))
  1061. (element SHORTCUT ($bold-seq$))
  1062. (element MOUSEBUTTON ($charseq$))
  1063. (element OPTION ($charseq$))
  1064. (element OPTIONAL ($charseq$))
  1065. (element PARAMETER ($italic-mono-seq$))
  1066. (element PROPERTY ($charseq$))
  1067. (element REPLACEABLE ($italic-mono-seq$))
  1068. (element RETURNVALUE ($charseq$))
  1069. (element STRUCTFIELD ($italic-mono-seq$))
  1070. (element STRUCTNAME ($charseq$))
  1071. (element SYMBOL ($charseq$))
  1072. (element SYSTEMITEM ($charseq$))
  1073. (element TOKEN ($charseq$))
  1074. (element TYPE ($charseq$))
  1075. (element USERINPUT ($bold-mono-seq$))
  1076. (element ABBREV ($charseq$))
  1077. (element ACRONYM ($charseq$))
  1078. (element CITATION ($charseq$))
  1079. (element CITEREFENTRY ($charseq$))
  1080. (element CITETITLE ($charseq$))
  1081. (element CO ($charseq$))
  1082. (element EMPHASIS ($bold-seq$))
  1083. (element FIRSTTERM ($bold-seq$))
  1084. (element FOREIGNPHRASE ($italic-seq$))
  1085. (element MARKUP ($charseq$))
  1086. (element PHRASE ($charseq$))
  1087. (element QUOTE ($charseq$))
  1088. (element SGMLTAG ($charseq$))
  1089. (element TRADEMARK ($charseq$))
  1090. (element WORDASWORD ($italic-seq$))
  1091.  
  1092. (element LINEANNOTATION
  1093.   (make sequence
  1094.     use: para-style
  1095.     (process-children-trim)))
  1096.  
  1097. (define ($ss-seq$ plus-or-minus)
  1098.   (make sequence
  1099.     font-size:
  1100.       (* (inherited-font-size) %ss-size-factor%)
  1101.     position-point-shift:
  1102.       (plus-or-minus (* (inherited-font-size) %ss-shift-factor%))
  1103.     (process-children-trim)))
  1104.  
  1105. (element SUPERSCRIPT ($ss-seq$ +))
  1106. (element SUBSCRIPT ($ss-seq$ -))
  1107.  
  1108.  
  1109. ;; ========================= LINKS AND ANCHORS ==========================
  1110.  
  1111. (element LINK (empty-sosofo))
  1112. (element OLINK (empty-sosofo))
  1113. (element ULINK (empty-sosofo))
  1114. (element FOOTNOTEREF (empty-sosofo))
  1115. (element XREF (empty-sosofo))
  1116. (element ANCHOR (empty-sosofo))
  1117. (element BEGINPAGE (empty-sosofo))
  1118.  
  1119. ;; =========================== INDEX ELEMENTS ===========================
  1120.  
  1121. (element INDEXENTRY (process-children))
  1122. (element PRIMARYIE ($paragraph$))
  1123. (element SECONDARYIE ($paragraph$))
  1124. (element TERTIARYIE ($paragraph$))
  1125. (element SEEIE ($paragraph$))
  1126. (element SEEALSOIE ($paragraph$))
  1127.  
  1128.  
  1129. ;; 961028 -- bosak
  1130. ;;   TABLE element spec changed
  1131. ;;   p-style changed to para-style
  1132. ;; 961123 -- bosak
  1133. ;;   TABLE and TITLE elements modified
  1134. ;;   margins changed
  1135. ;;   added INFORMALTABLE (docbook-specific)
  1136. ;; 961124 -- bosak
  1137. ;;   mods to THEAD
  1138. ;; 970116 -- bosak
  1139. ;;   method for assigning frame-attribute on TGROUP changed from
  1140. ;;     attribute-string to inherited-attribute string to cope
  1141. ;;     with FRAME attribute set on either TABLE or INFORMALTABLE
  1142. ;;     (docbook-specific)
  1143. ;;   mods to TITLE, cell indents & margins
  1144. ;; 970215 -- berglund, communicated 970128
  1145. ;;   n-rows-spanned fixed to accommodate #IMPLIED value for morerows
  1146. ;;     rather than default value of 0 (DocBook 2.x -> 3.0 change to
  1147. ;;     align with SGML Open table model)
  1148. ;; 970215 -- graham, communicated 970202
  1149. ;;   pgwide accommodated
  1150. ;; Notes by bosak:
  1151. ;;   For (informal)tables and table titles to align correctly with
  1152. ;;     paragraphs immediately preceding them, the (informal)table
  1153. ;;     must be a child of the preceding paragraph.
  1154. ;;   To get a table frame and rules around each cell, you must set
  1155. ;;     frame="all" on every TABLE and INFORMALTABLE and
  1156. ;;     colsep=1 rowsep=1 on every TGROUP.
  1157. ;;   All further notes by Anders Berglund except where indicated.
  1158. ;;
  1159. ;; ============================ TABLES ===============================
  1160. ;
  1161. ; *** DRAFT VERSION ****
  1162. ;
  1163. ; Copyright (C), Berglund Consulting & Type Foundry 1996.
  1164. ; Permission to copy in any form is granted for use in  
  1165. ; DSSSL applications, provided this notice is included in
  1166. ; all copies.
  1167. ;
  1168. ; This supports the specifications in the "Exchange model" in the
  1169. ; SGML Open Technical Resolution TR 9503:1995
  1170. ; with the modification that SPANSPECs are supported.
  1171. ; Thus the following is NOT supported:
  1172. ; - mixed measure - e.g. 2*+3pt - for colspecs
  1173.  
  1174. ; Caution
  1175. ; - NOTE that vertical column spans are not supported by Microsoft Word
  1176. ; - NOTE that for RTF the table foot is placed at the end of the table;
  1177. ;   table heads are correctly repeated at page breaks in a table
  1178. ;
  1179. ; Tailor these values to go with the rest of the DSSSL application
  1180. ; and for the desired default values
  1181. ;
  1182. (define %cals-rule-default% 0)
  1183. (define %cals-valign-default% "TOP")
  1184. ; cell margins - a 4pt value assumes that the paragraphs in the
  1185. ;                cells have a 0 start and end indent so that a  
  1186. ;                margin needs to be specified on the cells
  1187. ;; bosak has tweaked all these
  1188. (define %cals-cell-before-row-margin% 3pt)
  1189. (define %cals-cell-after-row-margin% 3pt)
  1190. (define %cals-cell-before-column-margin% 3pt)
  1191. (define %cals-cell-after-column-margin% 3pt)
  1192. ; value for start and end indent; initial value for inheritance in the
  1193. ;                                 cells
  1194. (define %cals-cell-content-start-indent% 3pt)
  1195. (define %cals-cell-content-end-indent% 2pt)
  1196. ;
  1197. ; These may need changing for the desired style
  1198. ;
  1199. (element INFORMALTABLE
  1200.   (make display-group
  1201.     space-before: %block-sep%
  1202.     space-after: %block-sep%
  1203.     (process-children)))
  1204.  
  1205. (element TABLE
  1206.   (make display-group
  1207.     space-before: %block-sep%
  1208.     space-after: %block-sep%
  1209.     ;; pgwide handling by Tony Graham
  1210.     start-indent: (let ((pgwide (attribute-string "pgwide")))
  1211.             (if
  1212.              (string? pgwide)
  1213.              (if
  1214.               (not
  1215.                (= (string->number pgwide) 0))
  1216.               %pgwide-start-indent%
  1217.               (inherited-start-indent))
  1218.              (inherited-start-indent)))
  1219.     (with-mode table-caption-mode
  1220.            (process-first-descendant "TITLE"))
  1221.     (process-children)))
  1222.  
  1223. (mode table-caption-mode
  1224.   (element TITLE
  1225.     (let ((label (attribute-string "label" (ancestor "table"))))
  1226.       (make paragraph
  1227.         use: para-style
  1228.         font-weight: 'bold
  1229.         space-before: %block-sep%
  1230.         space-after: %block-sep%
  1231.         keep-with-next?: #t
  1232.         (literal
  1233.          (string-append
  1234.           "Table "
  1235.           (if label
  1236.           label
  1237.         (format-number (element-number (parent (current-node))) "1"))
  1238.           ". "))
  1239.         (process-children-trim)))))
  1240.  
  1241. ;---------------------------------------------------------------------
  1242. ;   
  1243. ; There should be no need to change the specification below 
  1244. ;
  1245. ;---------------------------------------------------------------------
  1246.  
  1247. (define (CALS-COLSPEC-UNIT u)
  1248.  (if (string? u)
  1249.     (let ((strlen (string-length u)))
  1250.     (if (string=? "*" (substring u (- strlen 1) strlen)) 
  1251.         (let* ((pnum (substring u 0 (- strlen 1))))
  1252.              (if (number? (string->number pnum))
  1253.                   (table-unit (string->number pnum))
  1254.                   (table-unit 1)))
  1255.         (if (> strlen 2)
  1256.              (let ((u-s-i (UNAME-START-INDEX u (- strlen 1))))
  1257.              (if (= u-s-i 0) ;; there's no number here
  1258.                   1pi         ;; so return something that might work
  1259.                   (if (= u-s-i strlen)           ;; there's no unit name here
  1260.                       (* (string->number u) 1pt) ;; so default to points
  1261.                       (let* ((unum (string->number
  1262.                                     (substring u 0 u-s-i)))
  1263.                               (uname (STRING-DOWNCASE
  1264.                                        (substring u u-s-i strlen))))
  1265.                         (case uname
  1266.                               (("mm") (* unum 1mm))
  1267.                               (("cm") (* unum 1cm))
  1268.                               (("in") (* unum 1in))
  1269.                               (("pi") (* unum 1pi))
  1270.                               (("pt") (* unum 1pt))
  1271.                               (else
  1272.                                (cond 
  1273.                                 ((number? unum)
  1274.                                  (* unum 1pt))
  1275.                                 ((number? (string->number u))
  1276.                                  (* (string->number u) 1pt))
  1277.                                       (else u))))))))
  1278.              (if (number? (string->number u))
  1279.                   (* (string->number u) 1pt)
  1280.                   (table-unit 1)))))
  1281.     (table-unit 1)))
  1282.  
  1283.  
  1284. ; given a node list "nodes" find the snl that has a gi matching "giname"
  1285. ; and an attribute "attname" that has the value "attval"
  1286. ; if no such node return #f
  1287. (define (GI-ATTVAL-NODE-IN-NODELIST giname attname attval nodes)
  1288.   (let* ((n (node-list-first nodes)) ;; has to be let* bosak 961123
  1289.      (attnamestr (attribute-string attname n))) ;; added by bosak 961123
  1290.     (if (and (string=? (gi n) giname) attnamestr (string=? attnamestr attval)) ;; check for attnamestr added by bosak 961123
  1291. ;;    (if (and (string=? (gi n) giname) (string=? (attribute-string attname n) attval)) ;; old version dies if attribute-string returns #f
  1292.         n
  1293.         (if (node-list-empty? (node-list-rest nodes))
  1294.             #f
  1295.             (GI-ATTVAL-NODE-IN-NODELIST giname attname attval (node-list-rest nodes))))))
  1296.  
  1297. ; find the child number of the "colspec" that has a "colname" attribute
  1298. ; whose value matches the "namest" attribute value of the "spanspec"
  1299. ; whose "spannane" attribute value matches the "spanname" value of the "entry"
  1300. (define (CALS-ENTRY-SPANSPEC-START)
  1301.   (child-number
  1302.     (GI-ATTVAL-NODE-IN-NODELIST "COLSPEC"  "colname"
  1303.       (attribute-string "namest" 
  1304.         (GI-ATTVAL-NODE-IN-NODELIST "SPANSPEC" "spanname"
  1305.           (attribute-string "spanname") (children (ancestor "tgroup"))))
  1306.       (children (ancestor "tgroup")))))
  1307.  
  1308. ; find the child number of the "colspec" that has a "colname" attribute
  1309. ; value matching the "namest" attribute value of the "entry"
  1310. (define (CALS-ENTRY-COLSPEC-NAMEST-NODE)
  1311.   (GI-ATTVAL-NODE-IN-NODELIST "COLSPEC" "colname"              
  1312.     (attribute-string "namest") (children (ancestor "tgroup"))))
  1313. (define (CALS-ENTRY-COLSPEC-NAMEST)
  1314.   (child-number (CALS-ENTRY-COLSPEC-NAMEST-NODE)))
  1315.  
  1316. ; calculate the spane information from "namest" and "nameend" on
  1317. ; the "entry"   
  1318. (define (CALS-ENTRY-COLSPEC-NAMEEND-NODE)
  1319.   (GI-ATTVAL-NODE-IN-NODELIST "COLSPEC" "colname"              
  1320.     (attribute-string "nameend") (children (ancestor "tgroup"))))
  1321. (define (CALS-ENTRY-NAMEST-NAMEEND-NUMCOLS)
  1322.   (if (CALS-ENTRY-COLSPEC-NAMEEND-NODE)
  1323.      (+ 1
  1324.         (- (child-number (CALS-ENTRY-COLSPEC-NAMEEND-NODE))
  1325.            (child-number (CALS-ENTRY-COLSPEC-NAMEST-NODE))
  1326.      ))
  1327.      1))
  1328.  
  1329. ; find the child number of the "colspec" that has a "colname" attribute
  1330. ; value matching the "colname" attribute value of the "entry"
  1331. (define (CALS-ENTRY-COLSPEC-NAME-NODE)
  1332.   (GI-ATTVAL-NODE-IN-NODELIST "COLSPEC" "colname"               
  1333.     (attribute-string "colname") (children (ancestor "tgroup"))))
  1334. (define (CALS-ENTRY-COLSPEC-NAME)
  1335.   (child-number (CALS-ENTRY-COLSPEC-NAME-NODE)))
  1336.  
  1337. ; find the number of columns spanned by calculating the difference in child
  1338. ; number of the "colspec"s that have a "colname" attribute whose value
  1339. ; matches the "nameend" and "namest" attribute values of the "spanspec"
  1340. ; whose "spannane" attribute value matches the "spanname" value of the "entry"
  1341. (define (CALS-ENTRY-SPANSPEC-NUMCOLS)
  1342.   (let ((spanspec-node 
  1343.           (GI-ATTVAL-NODE-IN-NODELIST "SPANSPEC" "spanname"
  1344.             (attribute-string "spanname") (children (ancestor "tgroup")))))
  1345.     (+ 1
  1346.        (- (child-number
  1347.             (GI-ATTVAL-NODE-IN-NODELIST "COLSPEC"  "colname"
  1348.               (attribute-string "nameend" spanspec-node)
  1349.               (children (ancestor "tgroup"))))
  1350.           (child-number
  1351.             (GI-ATTVAL-NODE-IN-NODELIST "COLSPEC"  "colname"
  1352.               (attribute-string "namest" spanspec-node)
  1353.               (children (ancestor "tgroup"))))))))
  1354.  
  1355. ; find a "colspec" for a separator
  1356. (define (CALS-ENTRY-FIND-SEP-COLSPEC)
  1357.   (cond ((attribute-string "spanname") 
  1358.          (let ((spanspec-node 
  1359.                (GI-ATTVAL-NODE-IN-NODELIST "SPANSPEC" "spanname"
  1360.                (attribute-string "spanname") (children (ancestor "tgroup")))))
  1361.               (GI-ATTVAL-NODE-IN-NODELIST "COLSPEC"  "colname"
  1362.                 (attribute-string "nameend" spanspec-node)
  1363.                 (children (ancestor "tgroup")))))
  1364.         ((attribute-string "namest")   
  1365.          (CALS-ENTRY-COLSPEC-NAMEST-NODE))
  1366.         ((attribute-string "colname")  
  1367.          (CALS-ENTRY-COLSPEC-NAME-NODE))    
  1368.         (else #f)))
  1369.  
  1370. ; find a "rowsep" specification by looking - in order - at
  1371. ; "entry", "row", "colspec", "tgroup", "table"
  1372. (define (CALS-ENTRY-FIND-ROWSEP)
  1373.   (if (attribute-string "rowsep")
  1374.     (string->number (attribute-string "rowsep"))
  1375.     (if (attribute-string "rowsep" (ancestor "row"))
  1376.       (string->number (attribute-string "rowsep" (ancestor "row")))
  1377.       (let ((col-spec-node (CALS-ENTRY-FIND-SEP-COLSPEC)))
  1378.         (if (and col-spec-node (attribute-string "rowsep" col-spec-node))
  1379.           (string->number (attribute-string "rowsep" col-spec-node))
  1380.           (if (attribute-string "rowsep" (ancestor "tgroup"))
  1381.             (string->number (attribute-string "rowsep" (ancestor "tgroup")))
  1382.             (if (attribute-string "rowsep" (ancestor "table"))
  1383.               (string->number (attribute-string "rowsep" (ancestor "table")))
  1384.               %cals-rule-default%)))))))
  1385. ; set up a value for the row separator - no distinction for values > 0
  1386. ; if no rowsep found then use default separator
  1387. (define (CALS-ENTRY-ROWSEP)
  1388.   (let ((rowsep-value (CALS-ENTRY-FIND-ROWSEP)))
  1389.     (if (> rowsep-value 0)
  1390.        #t
  1391.        #f)))
  1392.  
  1393. ; find a "rowsep" specification by looking - in order - at
  1394. ; current "colspec", "tgroup", "table"
  1395. (define (CALS-COLSPEC-FIND-ROWSEP)
  1396.   (if (attribute-string "rowsep")
  1397.     (string->number (attribute-string "rowsep"))
  1398.     (if (attribute-string "rowsep" (ancestor "tgroup"))
  1399.       (string->number (attribute-string "rowsep" (ancestor "tgroup")))
  1400.       (if (attribute-string "rowsep" (ancestor "table"))
  1401.         (string->number (attribute-string "rowsep" (ancestor "table")))
  1402.         %cals-rule-default%))))
  1403. ; set up a value for the row separator - no distinction for values > 0
  1404. ; if no rowsep found then use default separator
  1405. (define (CALS-COLSPEC-ROWSEP)
  1406.   (let ((rowsep-value (CALS-COLSPEC-FIND-ROWSEP)))
  1407.     (if (> rowsep-value 0)
  1408.        #t
  1409.        #f)))
  1410.  
  1411. ; find a "colsep" specification by looking - in order - at
  1412. ; "entry", "colspec", "tgroup", "table"
  1413. (define (CALS-ENTRY-FIND-COLSEP)
  1414.   (if (attribute-string "colsep")
  1415.     (string->number (attribute-string "colsep"))
  1416.     (let ((col-spec-node (CALS-ENTRY-FIND-SEP-COLSPEC)))
  1417.       (if (and col-spec-node (attribute-string "colsep" col-spec-node))
  1418.         (string->number (attribute-string "colsep" col-spec-node))
  1419.         (if (attribute-string "colsep" (ancestor "tgroup"))
  1420.           (string->number (attribute-string "colsep" (ancestor "tgroup")))
  1421.           (if (attribute-string "colsep" (ancestor "table"))
  1422.             (string->number (attribute-string "colsep" (ancestor "table")))
  1423.             %cals-rule-default%))))))
  1424. ; set up a value for the column separator - no distinction for values > 0
  1425. ; if no colsep found then use default separator
  1426. (define (CALS-ENTRY-COLSEP)
  1427.   (let ((colsep-value (CALS-ENTRY-FIND-COLSEP)))
  1428.     (if (> colsep-value 0)
  1429.        #t
  1430.        #f)))
  1431.  
  1432. ; find a "colsep" specification by looking - in order - at
  1433. ; current "colspec", "tgroup", "table"
  1434. (define (CALS-COLSPEC-FIND-COLSEP)
  1435.   (if (attribute-string "colsep")
  1436.     (string->number (attribute-string "colsep"))
  1437.     (if (attribute-string "colsep" (ancestor "tgroup"))
  1438.       (string->number (attribute-string "colsep" (ancestor "tgroup")))
  1439.       (if (attribute-string "colsep" (ancestor "table"))
  1440.         (string->number (attribute-string "colsep" (ancestor "table")))
  1441.         %cals-rule-default%))))
  1442. ; set up a value for the row separator - no distinction for values > 0
  1443. ; if no colsep found then use default separator
  1444. (define (CALS-COLSPEC-COLSEP)
  1445.   (let ((colsep-value (CALS-COLSPEC-FIND-COLSEP)))
  1446.     (if (> colsep-value 0)
  1447.        #t
  1448.        #f)))
  1449.  
  1450. ; find a "valign" specification by looking - in order - at
  1451. ; "entry", "tbody", "thead", "tfoot"
  1452. (define (CALS-ENTRY-FIND-VALIGN)
  1453.   (if (attribute-string "valign")
  1454.     (string->number (attribute-string "valign"))
  1455.       (if (attribute-string "valign" (ancestor "tbody"))
  1456.         (string->number (attribute-string "valign" (ancestor "tbody")))
  1457.         (if (attribute-string "valign" (ancestor "thead"))
  1458.           (string->number (attribute-string "valign" (ancestor "thead")))
  1459.           (if (attribute-string "valign" (ancestor "tfoot"))
  1460.             (string->number (attribute-string "valign" (ancestor "tfoot")))
  1461.             %cals-valign-default%)))))
  1462. ; set up a value for the row alignment
  1463. (define (CALS-ENTRY-VALIGN)
  1464.   (let ((valign-value (CALS-ENTRY-FIND-VALIGN)))
  1465.     (case valign-value
  1466.        (("TOP") 'start)
  1467.        (("MIDDLE") 'center)
  1468.        (("BOTTOM") 'end)
  1469.        (else 'start))))
  1470.  
  1471. (element TGROUP
  1472.   (let ((frame-attribute (inherited-attribute-string "frame")))
  1473.     (make table
  1474.       before-row-border:  (if frame-attribute
  1475.                   (case frame-attribute
  1476.                     (("ALL") #t)
  1477.                     (("SIDES") #f)
  1478.                     (("TOP") #t)
  1479.                     (("BOTTOM") #f)
  1480.                     (("TOPBOT") #t)
  1481.                     (("NONE") #f)
  1482.                     (else #f))
  1483.                 (if (> %cals-rule-default% 0)
  1484.                     #t
  1485.                   #f)) 
  1486.       after-row-border:   (if frame-attribute
  1487.                   (case frame-attribute
  1488.                     (("ALL") #t)
  1489.                     (("SIDES") #f)
  1490.                     (("TOP") #f)
  1491.                     (("BOTTOM") #t)
  1492.                     (("TOPBOT") #t)
  1493.                     (("NONE") #f)
  1494.                     (else #f))
  1495.                 (if (> %cals-rule-default% 0)
  1496.                     #t
  1497.                   #f)) 
  1498.       before-column-border: (if frame-attribute
  1499.                     (case frame-attribute
  1500.                       (("ALL") #t)
  1501.                       (("SIDES") #t)
  1502.                       (("TOP") #f)
  1503.                       (("BOTTOM") #f)
  1504.                       (("TOPBOT") #f)
  1505.                       (("NONE") #f)
  1506.                       (else #f))
  1507.                   (if (> %cals-rule-default% 0)
  1508.                       #t
  1509.                     #f)) 
  1510.       after-column-border:  (if frame-attribute
  1511.                     (case frame-attribute
  1512.                       (("ALL") #t)
  1513.                       (("SIDES") #t)
  1514.                       (("TOP") #f)
  1515.                       (("BOTTOM") #f)
  1516.                       (("TOPBOT") #f)
  1517.                       (("NONE") #f)
  1518.                       (else #f))
  1519.                   (if (> %cals-rule-default% 0)
  1520.                       #t
  1521.                     #f)) 
  1522.       (make table-part
  1523.         content-map: '((thead header)
  1524.                    (tbody #f)
  1525.                    (tfoot footer))
  1526.         (process-children)))))
  1527.  
  1528. (element COLSPEC 
  1529.   (make table-column
  1530.         cell-after-column-border: (CALS-COLSPEC-COLSEP)
  1531.         cell-after-row-border: (CALS-COLSPEC-ROWSEP)
  1532.         width: (CALS-COLSPEC-UNIT (attribute-string "colwidth"))))
  1533.  
  1534. (element THEAD
  1535.   (make sequence
  1536.         label: 'thead))
  1537.  
  1538. (element TFOOT
  1539.   (make sequence
  1540.         label: 'tfoot))
  1541.  
  1542. (element TBODY
  1543.   (make sequence
  1544.         label: 'tbody))
  1545.  
  1546. (element ROW
  1547.   (if (attribute-string "rowsep")
  1548.     (make table-row
  1549.           cell-after-row-border: (let ((rowsep-value (string->number (attribute-string "rowsep"))))
  1550.                                    (if (> rowsep-value 0)
  1551.                                      #t
  1552.                                      #f))
  1553.           (process-children-trim))
  1554.     (make table-row
  1555.           (process-children-trim))))
  1556.  
  1557. (element ENTRY
  1558.   (if (attribute-string "spanname")
  1559.     (make table-cell
  1560.           column-number: (CALS-ENTRY-SPANSPEC-START)
  1561.           n-columns-spanned: (CALS-ENTRY-SPANSPEC-NUMCOLS)
  1562.       n-rows-spanned: (let ((morerows-value (attribute-string "morerows")))
  1563.                 (if morerows-value
  1564.                 (+ 1 (string->number morerows-value))
  1565.                   1))
  1566.           cell-row-alignment: (CALS-ENTRY-VALIGN)
  1567.           cell-after-column-border: (CALS-ENTRY-COLSEP)
  1568.           cell-after-row-border: (CALS-ENTRY-ROWSEP)
  1569.           cell-before-row-margin: %cals-cell-before-row-margin%
  1570.           cell-after-row-margin: %cals-cell-after-row-margin%
  1571.           cell-before-column-margin: %cals-cell-before-column-margin%
  1572.           cell-after-column-margin: %cals-cell-after-column-margin%
  1573.           start-indent: %cals-cell-content-start-indent%
  1574.           end-indent: %cals-cell-content-end-indent%
  1575.           (process-children-trim))
  1576.     (if (attribute-string "namest")
  1577.       (make table-cell
  1578.             column-number: (CALS-ENTRY-COLSPEC-NAMEST)
  1579.             n-columns-spanned: (CALS-ENTRY-NAMEST-NAMEEND-NUMCOLS)
  1580.         n-rows-spanned: (let ((morerows-value (attribute-string "morerows")))
  1581.                   (if morerows-value
  1582.                   (+ 1 (string->number morerows-value))
  1583.                 1))
  1584.             cell-row-alignment: (CALS-ENTRY-VALIGN)
  1585.             cell-after-column-border: (CALS-ENTRY-COLSEP)
  1586.             cell-after-row-border: (CALS-ENTRY-ROWSEP)
  1587.             cell-before-row-margin: %cals-cell-before-row-margin%
  1588.             cell-after-row-margin: %cals-cell-after-row-margin%
  1589.             cell-before-column-margin: %cals-cell-before-column-margin%
  1590.             cell-after-column-margin: %cals-cell-after-column-margin%
  1591.             start-indent: %cals-cell-content-start-indent%
  1592.             end-indent: %cals-cell-content-end-indent%
  1593.             (process-children-trim))
  1594.       (if (attribute-string "colname")
  1595.         (make table-cell
  1596.               column-number: (CALS-ENTRY-COLSPEC-NAME)
  1597.           n-rows-spanned: (let ((morerows-value (attribute-string "morerows")))
  1598.                 (if morerows-value
  1599.                     (+ 1 (string->number morerows-value))
  1600.                   1))
  1601.               cell-row-alignment: (CALS-ENTRY-VALIGN)
  1602.               cell-after-column-border: (CALS-ENTRY-COLSEP)
  1603.               cell-after-row-border: (CALS-ENTRY-ROWSEP)
  1604.               cell-before-row-margin: %cals-cell-before-row-margin%
  1605.               cell-after-row-margin: %cals-cell-after-row-margin%
  1606.               cell-before-column-margin: %cals-cell-before-column-margin%
  1607.               cell-after-column-margin: %cals-cell-after-column-margin%
  1608.               start-indent: %cals-cell-content-start-indent%
  1609.               end-indent: %cals-cell-content-end-indent%
  1610.               (process-children-trim))
  1611.  
  1612.         (make table-cell
  1613.           n-rows-spanned: (let ((morerows-value (attribute-string "morerows")))
  1614.                 (if morerows-value
  1615.                     (+ 1 (string->number morerows-value))
  1616.                   1))
  1617.               cell-row-alignment: (CALS-ENTRY-VALIGN)
  1618.               cell-after-column-border: (CALS-ENTRY-COLSEP)
  1619.               cell-after-row-border: (CALS-ENTRY-ROWSEP)
  1620.               cell-before-row-margin: %cals-cell-before-row-margin%
  1621.               cell-after-row-margin: %cals-cell-after-row-margin%
  1622.               cell-before-column-margin: %cals-cell-before-column-margin%
  1623.               cell-after-column-margin: %cals-cell-after-column-margin%
  1624.               start-indent: %cals-cell-content-start-indent%
  1625.               end-indent: %cals-cell-content-end-indent%
  1626.               (process-children-trim))))))
  1627.  
  1628. ;; bosak 1996.11.23
  1629. (element (TABLE TITLE) (empty-sosofo)) ; don't show caption below table
  1630. (element (CHART TITLE) (empty-sosofo)) ; don't show caption below chart
  1631.  
  1632. (element SPANSPEC (empty-sosofo))
  1633.  
  1634. ;; ===================== END OF TABLES ===============================
  1635.  
  1636. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1637. ;; STOCK STYLESHEET PIECES ;;
  1638. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1639.  
  1640. ;; ============================== UNITS ================================
  1641.  
  1642. (define-unit pi (/ 1in 6))
  1643. (define-unit pt (/ 1in 72))
  1644. (define-unit px (/ 1in 96))
  1645.  
  1646. ;; "em" is defined in the parameters section of the stylesheet
  1647.  
  1648. ;; ========================= COMMON FUNCTIONS ===========================
  1649.  
  1650. (define (expt b n)
  1651.   (if (= n 0)
  1652.       1
  1653.       (* b (expt b (- n 1)))))
  1654.  
  1655. ;; per ISO/IEC 10179
  1656. (define (node-list-reduce nl proc init)
  1657.   (if (node-list-empty? nl)
  1658.       init
  1659.       (node-list-reduce (node-list-rest nl)
  1660.                         proc
  1661.                         (proc init (node-list-first nl)))))
  1662.  
  1663. ;; per ISO/IEC 10179
  1664. (define (node-list-length nl)
  1665.   (node-list-reduce nl
  1666.                     (lambda (result snl)
  1667.                       (+ result 1))
  1668.                     0))
  1669.  
  1670. (define if-front-page
  1671.   (external-procedure "UNREGISTERED::James Clark//Procedure::if-front-page"))
  1672.  
  1673. (define if-first-page
  1674.   (external-procedure "UNREGISTERED::James Clark//Procedure::if-first-page"))
  1675.  
  1676. (declare-characteristic page-number-format
  1677.    "UNREGISTERED::James Clark//Characteristic::page-number-format" "1")
  1678.  
  1679. (declare-characteristic page-number-restart?
  1680.    "UNREGISTERED::James Clark//Characteristic::page-number-restart?" #f)
  1681.  
  1682. (define upperalpha
  1683.   '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
  1684.     #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))
  1685.  
  1686. (define loweralpha
  1687.   '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
  1688.     #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))
  1689.  
  1690. (define (char-downcase ch)
  1691.   (case ch
  1692.     ((#\A) #\a) ((#\B) #\b) ((#\C) #\c) ((#\D) #\d) ((#\E) #\e)
  1693.     ((#\F) #\f) ((#\G) #\g) ((#\H) #\h) ((#\I) #\i) ((#\J) #\j)
  1694.     ((#\K) #\k) ((#\L) #\l) ((#\M) #\m) ((#\N) #\n) ((#\O) #\o)
  1695.     ((#\P) #\p) ((#\Q) #\q) ((#\R) #\r) ((#\S) #\s) ((#\T) #\t)
  1696.     ((#\U) #\u) ((#\V) #\v) ((#\W) #\w) ((#\X) #\x) ((#\Y) #\y)
  1697.     ((#\Z) #\z) (else ch)))
  1698.  
  1699. (define (LOWCASE slist)
  1700.   (if (null? slist)
  1701.       '()
  1702.       (cons (char-downcase (car slist)) (LOWCASE (cdr slist)))))
  1703.  
  1704. (define (STR2LIST s)
  1705.   (let ((len (string-length s)))
  1706.     (let loop ((i 0) (ln len))
  1707.      (if (= i len)
  1708.          '()
  1709.          (cons (string-ref s i) (loop (+ i 1) ln))))))
  1710.  
  1711. (define (STRING-DOWNCASE s)
  1712.   (apply string (LOWCASE (STR2LIST s))))
  1713.  
  1714. (define (UNAME-START-INDEX u last)
  1715.   (let ((c (string-ref u last)))
  1716.     (if (or (member c upperalpha) (member c loweralpha))
  1717.     (if (= last 0)
  1718.         0
  1719.         (UNAME-START-INDEX u (- last 1)))
  1720.         (+ last 1))))
  1721.  
  1722. (define (PARSEDUNIT u) ;; this doesn't deal with "%" yet
  1723.  (if (string? u)
  1724.   (let ((strlen (string-length u)))
  1725.     (if (> strlen 2)
  1726.     (let ((u-s-i (UNAME-START-INDEX u (- strlen 1))))
  1727.       (if (= u-s-i 0) ;; there's no number here
  1728.           1pi         ;; so return something that might work
  1729.           (if (= u-s-i strlen)           ;; there's no unit name here
  1730.           (* (string->number u) 1pt) ;; so default to points
  1731.           (let* ((unum (string->number
  1732.                    (substring u 0 u-s-i)))
  1733.              (uname (STRING-DOWNCASE
  1734.                  (substring u u-s-i strlen))))
  1735.             (case uname
  1736.               (("mm") (* unum 1mm))
  1737.               (("cm") (* unum 1cm))
  1738.               (("in") (* unum 1in))
  1739.               (("pi") (* unum 1pi))
  1740.               (("pc") (* unum 1pi))
  1741.               (("pt") (* unum 1pt))
  1742.               (("px") (* unum 1px))
  1743.               (("barleycorn") (* unum 2pi)) ;; extensible!
  1744.               (else
  1745.                (cond 
  1746.                 ((number? unum)
  1747.                  (* unum 1px))
  1748.                 ((number? (string->number u))
  1749.                  (* (string->number u) 1px))
  1750.                  (else u))))))))
  1751.         (if (number? (string->number u))
  1752.         (* (string->number u) 1px)
  1753.         1pi)))
  1754.     1pi))
  1755.  
  1756. (define (INLIST?)
  1757.   (let loop ((rest-of-list list-list))
  1758.        (if (null? rest-of-list)
  1759.        #f
  1760.        (if (have-ancestor? (car rest-of-list))
  1761.            #t
  1762.            (loop (cdr rest-of-list))))))
  1763.  
  1764. (define (HSIZE n)
  1765.   (let ((m (if (< n 0) 0 n)))
  1766.     (* %bf-size%
  1767.        (expt %hsize-bump-factor% m))))
  1768.  
  1769. (define (PARNUM)
  1770.   (child-number (parent (current-node))))
  1771.  
  1772. (define (FNUM n)
  1773.   (if (number? n)
  1774.       (format-number n "1")
  1775.       #f))
  1776.  
  1777. (define (BULLTREAT bullfcn ilevel override mark)
  1778.   (cond
  1779.    (override (bullfcn override ilevel))
  1780.    (mark (bullfcn mark ilevel))
  1781.    (else (bullfcn "bullet" ilevel))))
  1782.  
  1783. (define (BULLFONT m lvl)
  1784.   (let ((md (STRING-DOWNCASE m)))
  1785.     (case md
  1786.       (("bullet") "WingDings")
  1787.       (("box") "WingDings")
  1788.       (("checkbox") "WingDings")
  1789.       (("check") "WingDings")
  1790.       (("checkedbox") "WingDings")
  1791.       (("dash") %body-font-family%)
  1792.       (else %body-font-family%))))
  1793.  
  1794. (define (BULLSTR m lvl)
  1795.   (let ((md (STRING-DOWNCASE m)))
  1796.     (case md
  1797.       (("bullet") "l")
  1798.       (("box") "o")
  1799.       (("checkbox") "o")
  1800.       (("check") "ⁿ")
  1801.       (("checkedbox") "■")
  1802.     ;;   (("dash") "") \ 2 2 6
  1803.       (("none") "")
  1804.       (else "l"))))
  1805.  
  1806. (define (MSIZE m lvl f1 f2)
  1807.   (if (= lvl 1)
  1808.       (* %bf-size% f1)
  1809.       (* %bf-size% f2)))
  1810.  
  1811. (define (BULLSIZE m lvl)
  1812.   (let ((md (STRING-DOWNCASE m)))
  1813.     (case md
  1814.       (("bullet") (MSIZE m lvl 0.8 0.72))
  1815.       (("box") (MSIZE m lvl 0.9 0.72))
  1816.       (("checkbox") (MSIZE m lvl 0.9 0.72))
  1817.       (("check") (MSIZE m lvl 1.0 1.0))
  1818.       (("checkedbox") (MSIZE m lvl 1.0 1.0))
  1819.       (("dash") (MSIZE m lvl 1.0 1.0))
  1820.       (("none") (MSIZE m lvl 1.0 1.0))
  1821.       (else (MSIZE m lvl 1.0 1.0)))))
  1822.  
  1823. (define (BULLSHIFT m lvl)
  1824.   (let ((md (STRING-DOWNCASE m)))
  1825.     (case md
  1826.       (("bullet") 0.0em)
  1827.       (("box") (if (= lvl 1) 0.0em 0.1em))
  1828.       (("checkbox") (if (= lvl 1) 0.0em 0.1em))
  1829.       (("check") 0.0em)
  1830.       (("checkedbox") 0.0em)
  1831.       (("dash") 0.0em)
  1832.       (("none") 0.0em)
  1833.       (else 0.0em))))
  1834.  
  1835. ;; ====================== COMMON STYLE TEMPLATES =======================
  1836.  
  1837. (define ($block-container$)
  1838.   (make display-group
  1839.     space-before: %block-sep%
  1840.     space-after: %block-sep%
  1841.     start-indent: %body-start-indent%
  1842.     (process-children)))
  1843.  
  1844. (define ($para-container$)
  1845.   (make paragraph
  1846.     space-before: %para-sep%
  1847.     space-after: %para-sep%
  1848.     start-indent: (if (member (current-node) outer-parent-list)
  1849.               %body-start-indent%
  1850.               (inherited-start-indent))
  1851.     (process-children)))
  1852.  
  1853. (define ($indent-para-container$)
  1854.   (make paragraph
  1855.     space-before: %para-sep%
  1856.     space-after: %para-sep%
  1857.     start-indent: (+ (inherited-start-indent) (* (ILSTEP) 2))
  1858.     quadding: 'start
  1859.     (process-children-trim)))
  1860.  
  1861. (define para-style
  1862.   (style
  1863.    font-size: %bf-size%
  1864.    font-weight: 'medium
  1865.    font-posture: 'upright
  1866.    font-family-name: %body-font-family%
  1867.    line-spacing: (* %bf-size% %line-spacing-factor%)))
  1868.  
  1869. (define ($lowtitle$ tlevel)
  1870.   (let ((hs (HSIZE (- 3 tlevel))))
  1871.     (make paragraph
  1872.       font-family-name: %title-font-family%
  1873.       font-weight: 'bold
  1874.       font-size: hs
  1875.       line-spacing: (* hs %line-spacing-factor%)
  1876.       space-before: (* hs %head-before-factor%)
  1877.       space-after: (* hs %head-after-factor%)
  1878.       start-indent: %body-start-indent%
  1879.       quadding: 'start
  1880.       keep-with-next?: #t
  1881.       (process-children))))
  1882.  
  1883. (define ($runinhead$)
  1884.   (make sequence
  1885.     font-weight: 'bold
  1886.     (process-children)
  1887.     (literal "  ")))
  1888.  
  1889. (define ($bold-seq$)
  1890.   (make sequence
  1891.     font-weight: 'bold
  1892.     (process-children-trim)))
  1893.  
  1894. (define ($italic-seq$)
  1895.   (make sequence
  1896.     font-posture: 'italic
  1897.     (process-children-trim)))
  1898.  
  1899. (define ($bold-italic-seq$)
  1900.   (make sequence
  1901.     font-weight: 'bold
  1902.     font-posture: 'italic
  1903.     (process-children-trim)))
  1904.  
  1905. (define ($mono-seq$)
  1906.   (make sequence
  1907.     font-family-name: %mono-font-family%
  1908.     (process-children-trim)))
  1909.  
  1910. (define ($italic-mono-seq$)
  1911.   (make sequence
  1912.     font-family-name: %mono-font-family%
  1913.     font-posture: 'italic
  1914.     (process-children-trim)))
  1915.  
  1916. (define ($bold-mono-seq$)
  1917.   (make sequence
  1918.     font-family-name: %mono-font-family%
  1919.     font-weight: 'bold
  1920.     (process-children-trim)))
  1921.  
  1922. (define ($score-seq$ stype)
  1923.   (make score
  1924.     type: stype
  1925.     (process-children-trim)))
  1926.  
  1927. (define ($charseq$) (process-children))
  1928.  
  1929. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1930. ;; END OF STOCK STYLESHEET PIECES ;;
  1931. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1932.  
  1933.